The 640 MEG Shareware Studio 2/The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO/prog/pas_all.zip/TI676.ASC

Text File | 1992-02-28 | 6KB | 331 lines

  PRODUCT  :  Turbo Pascal                           NUMBER  :  676
  VERSION  :  6.0
       OS  :  MS/PC DOS
     DATE  :  February 28, 1992                        PAGE  :  1/5

    TITLE  :  Desktop Save State Using Streams




  {

  This program example demonstrates how to save your
  desktop using a stream.  It will give you the ability
  to insert windows on the desktop and save the current
  state in a .DSK file and load them from the file to
  restore its state.  Streams REQUIRE registration of
  descendant object types.  Turbo Pascal will check that
  all objects in the stream have been registered and
  produce a compiler error otherwise.

  }

  Program Simple_Stream;

  Uses Objects, Drivers, Views, Menus, App;

  Type
    PMyApp = ^MyApp;
    MyApp = Object(TApplication)
       Constructor Init;
       Procedure InitStatusLine; Virtual;
       Procedure InitMenuBar; Virtual;
       Procedure HandleEvent(var Event: TEvent); Virtual;
       Procedure NewWindow;
       Destructor Done; Virtual;
    End;

    PMyWindow = ^TMyWindow;
    TMyWindow = Object(TWindow)
       Constructor Init(Bounds: TRect; WinTitle: String; WindowNo:
  Word);
    End;

    PMyDeskTop = ^TMyDeskTop;
    TMyDeskTop = object(TDeskTop)
       Windw: PMyWindow;
       Constructor Load(var S: TBufStream);
       Procedure Store(var S: TBufStream); Virtual;
    End;

  Const
    cmNewWin   = 101;













  PRODUCT  :  Turbo Pascal                           NUMBER  :  676
  VERSION  :  6.0
       OS  :  MS/PC DOS
     DATE  :  February 28, 1992                        PAGE  :  2/5

    TITLE  :  Desktop Save State Using Streams




    cmSaveDesk = 102;
    cmLoadDesk = 103;

    RMyDeskTop: TStreamRec = (
       ObjType : 1001;
       VmtLink : Ofs(TypeOf(TMyDeskTop)^);
       Load    : @TMyDeskTop.Load;
       Store   : @TMyDeskTop.Store
    );

    RMyWindow: TStreamRec = (
       ObjType : 1002;
       VmtLink : Ofs(TypeOf(TMyWindow)^);
       Load    : @TMyWindow.Load;
       Store   : @TMyWindow.Store
    );

  Procedure SaveDeskStream;
  Var
    SaveFile:TBufStream;
  Begin
    SaveFile.Init('Rdesk.dsk',stCreate,1024);
    SaveFile.Put(DeskTop);
    If Savefile.Status <>0 then
      write('Bad Save', Savefile.Status);
    SaveFile.Done;
  End;

  Procedure LoadDeskStream;
  Var
    SaveFile:TBufStream;
  Begin
    SaveFile.Init('Rdesk.dsk',stOpen,1024);
    DeskTop^.Insert(PMyDeskTop(SaveFile.Get));
    If Savefile.Status <>0 then
      write('Bad Load',Savefile.Status)
    else
      DeskTop^.ReDraw;
    SaveFile.Done;
  End;

  { ** MyApp **}
  Constructor MyApp.Init;













  PRODUCT  :  Turbo Pascal                           NUMBER  :  676
  VERSION  :  6.0
       OS  :  MS/PC DOS
     DATE  :  February 28, 1992                        PAGE  :  3/5

    TITLE  :  Desktop Save State Using Streams




  Begin
    TApplication.Init;
    RegisterType(RMyDesktop);
    RegisterType(RDesktop);
    RegisterType(Rwindow);
    RegisterType(RMywindow);
    RegisterType(RFrame);
    RegisterType(RMenuBar);
    RegisterType(RStatusLine);
    RegisterType(RBackground);
  End;

  Destructor MyApp.Done;
  Begin
    TApplication.Done;
  End;

  Procedure MyApp.InitMenuBar;
  Var
    R: TRect;
  Begin
    GetExtent(R);
    R.B.Y := R.A.Y + 1;
    MenuBar := New(PMenuBar, Init(R, NewMenu(
      NewSubMenu('~F~ile', hcNoContext, NewMenu(
      NewItem('~N~ew', 'F4', kbF4, cmNewWin, hcNoContext,
      NewLine(
         NewItem('E~x~it', 'Alt-X', kbAltX, cmQuit, hcNoContext,
         Nil)))),
      NewSubMenu('~D~eskTop', hcNoContext, NewMenu(
         NewItem('~S~ave Desktop','',kbF2,cmSaveDesk,hcNoContext,
         NewItem('~L~oad Desktop','',kbF3,cmLoadDesk,hcNoContext,
      nil))),nil)))));
  End;

  Procedure MyApp.InitStatusLine;
  Var
    R: TRect;
  Begin
    GetExtent(R);
    R.A.Y := R.B.Y - 1;
    StatusLine := New(PStatusLine, Init(R,
    NewStatusDef(0, $FFFF,













  PRODUCT  :  Turbo Pascal                           NUMBER  :  676
  VERSION  :  6.0
       OS  :  MS/PC DOS
     DATE  :  February 28, 1992                        PAGE  :  4/5

    TITLE  :  Desktop Save State Using Streams




      NewStatusKey('', kbF10, cmMenu,
      NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
      NewStatusKey('~F4~ New', kbF4, cmNewWin,
      NewStatusKey('~Alt-F3~ Close', kbAltF3, cmClose,
      nil)))),
    nil)));
  End;

  Procedure MyApp.HandleEvent(var Event: TEvent);
  Begin
    TApplication.HandleEvent(Event);
    if Event.What = evCommand then
      Begin
        Case Event.Command of
          cmNewWin: NewWindow;
          cmSaveDesk: SaveDeskStream;
          cmLoadDesk: LoadDeskStream;
        else
          Exit;
        End;
        ClearEvent(Event);
      End;
  End;

  Procedure MyApp.NewWindow;
  Var
    Window:PMyWindow;
    R: TRect;
  Begin
    R.Assign(0, 0, 24, 7);
    R.Move(Random(55), Random(16));
    Window := New(PMyWindow, Init(R, 'Demo Window', 1));
    DeskTop^.Insert(Window);
  End;

  { ** MyDeskTop **}
  Constructor TMyDeskTop.Load(Var S: TBufStream);
  Begin
    TDeskTop.Load(S);
    GetSubViewPtr(S,Windw);
  End;

  Procedure TMyDeskTop.Store(Var S: TBufStream);













  PRODUCT  :  Turbo Pascal                           NUMBER  :  676
  VERSION  :  6.0
       OS  :  MS/PC DOS
     DATE  :  February 28, 1992                        PAGE  :  5/5

    TITLE  :  Desktop Save State Using Streams




  Begin
    TDeskTop.Store(S);
    PutSubViewPtr(S,Windw);
  End;

  { ** MyWindow **}
  Constructor TMyWindow.Init(Bounds: TRect; WinTitle: String;
  WindowNo: Word);
  Begin
    TWindow.init(Bounds,WinTitle,WindowNo);
  End;

  { Main Program }
  Var
    MyTApp:MyApp;

  Begin
    MyTApp.Init;
    MyTApp.Run;
    MyTApp.Done;
  End.